home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / guile-ii.src / guile-ii / guile-src / slib / lineio.scm < prev    next >
Encoding:
Text File  |  1994-05-25  |  1.6 KB  |  51 lines
  1. ; "lineio.scm", line oriented input/output functions for Scheme.
  2. ; Copyright (c) 1992, 1993 Aubrey Jaffer
  3. ;
  4. ;Permission to copy this software, to redistribute it, and to use it
  5. ;for any purpose is granted, subject to the following restrictions and
  6. ;understandings.
  7. ;
  8. ;1.  Any copy made of this software must include this copyright notice
  9. ;in full.
  10. ;
  11. ;2.  I have made no warrantee or representation that the operation of
  12. ;this software will be error-free, and I am under no obligation to
  13. ;provide any services, by way of maintenance, update, or otherwise.
  14. ;
  15. ;3.  In conjunction with products arising from the use of this
  16. ;material, there shall be no use of my name in any advertising,
  17. ;promotional, or sales literature without prior written consent in
  18. ;each case.
  19.  
  20. (define (read-line . arg)
  21.   (let* ((char (apply read-char arg)))
  22.     (if (eof-object? char)
  23.     char
  24.     (do ((char char (apply read-char arg))
  25.          (clist '() (cons char clist)))
  26.         ((or (eof-object? char) (char=? #\newline char))
  27.          (list->string (reverse clist)))))))
  28.  
  29. (define (read-line! str . arg)
  30.   (let* ((char (apply read-char arg))
  31.      (len (+ -1 (string-length str))))
  32.     (if (eof-object? char)
  33.     char
  34.     (do ((char char (apply read-char arg))
  35.          (i 0 (+ 1 i)))
  36.         ((or (eof-object? char)
  37.          (char=? #\newline char)
  38.          (>= i len))
  39.          (cond ((or (eof-object? char) (char=? #\newline char))
  40.             i)
  41.            (else
  42.             (string-set! str i char)
  43.             (set! char (apply peek-char arg))
  44.             (if (or (eof-object? char) (char=? #\newline char))
  45.             (+ 1 i) #f))))
  46.       (string-set! str i char)))))
  47.  
  48. (define (write-line str . arg)
  49.   (apply display str arg)
  50.   (apply newline arg))
  51.